home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / TCOPY.M < prev    next >
Encoding:
Text File  |  1990-06-12  |  4.4 KB  |  133 lines
  1. MODULE TCopy; (*$ E MTP *)
  2.  
  3. (* Kopiert Dateien mit Erhalt des Datums und Backup/Update-Option *)
  4. (* Subdirs werden mitkopiert *)
  5.  
  6.  *!!! achtung: läuft noch nicht richtig: der zielpfad wird noch nicht
  7.  *  beim rekursiven DirQuery angepaßt!
  8.  
  9. FROM SYSTEM IMPORT ADR;
  10.  
  11. IMPORT GEMDOSIO;
  12.  
  13. FROM InOut IMPORT WriteLn, Read, WriteString;
  14.  
  15. FROM ArgCV IMPORT PtrArgStr, InitArgCV;
  16.  
  17. FROM Clock IMPORT Time, Date, PackTime, PackDate, UnpackTime, UnpackDate;
  18.  
  19. FROM Directory IMPORT GetDirEntry, DirQuery, FileAttrSet,
  20.         FileAttr, SetFileAttr, DirEntry;
  21.  
  22. FROM Files IMPORT File, Open, Create, Access, ReplaceMode, GetStateMsg,
  23.         State, Close, SetDateTime;
  24.  
  25. FROM Binary IMPORT ReadBytes, WriteBytes;
  26.  
  27. FROM Strings IMPORT String, Upper, Compare, Relation;
  28.  
  29. FROM FuncStrings IMPORT ConcStr;
  30.  
  31.  
  32. VAR     backup, update: BOOLEAN;
  33.         argv: ARRAY [0..3] OF PtrArgStr;
  34.         argc: CARDINAL;
  35.         buf: ARRAY [1..$4000] OF CARDINAL; (* 32 KB *)
  36.  
  37.  
  38. PROCEDURE showErr ( i: INTEGER );
  39.   VAR msg: ARRAY [0..31] OF CHAR;
  40.   BEGIN
  41.     WriteLn;
  42.     WriteString ('Fehler: ');
  43.     GetStateMsg ( i, msg );
  44.     WriteString ( msg );
  45.     WriteLn;
  46.   END showErr;
  47.  
  48.  
  49. PROCEDURE query ( REF path: ARRAY OF CHAR; entry: DirEntry ): BOOLEAN;
  50.   VAR dname: String; exist: BOOLEAN; destentry: DirEntry;
  51.       ch: CHAR; sf, df: File; n: LONGCARD; res: INTEGER;
  52.   BEGIN
  53.     IF (subdirAttr IN entry.attr) THEN
  54.       IF entry.name [0] # '.' THEN
  55.         DirQuery (ConcStr (path, '*.*'), FileAttrSet {}, query, res );
  56.         IF res < 0 THEN showErr (res) END
  57.       END
  58.     ELSIF NOT (volLabelAttr IN entry.attr) THEN
  59.       dname:= ConcStr (argv[2]^, entry.name);
  60.       GetDirEntry (dname, destentry, res);
  61.       exist:= res >= 0;
  62.       IF ( backup AND NOT exist )
  63.       OR NOT ( update OR backup )
  64.       OR ( exist AND (   65636 * LONG(PackDate(entry.date))
  65.                                + LONG(PackTime(entry.time))
  66.                        > 65636 * LONG(PackDate(destentry.date))
  67.                                + LONG(PackTime(destentry.time)) ) )
  68.       THEN
  69.         WriteString (dname);
  70.         IF exist & NOT backup & NOT update THEN
  71.           WriteString ('  existiert bereits. Ersetzen? (J/N) ');
  72.           Read (ch);
  73.           IF CAP (ch) # 'J' THEN
  74.             RETURN TRUE
  75.           END
  76.         END;
  77.         (* kopieren *)
  78.         WriteLn;
  79.         Open (sf, ConcStr (path, entry.name), readOnly);
  80.         Create (df, dname, writeOnly, replaceOld);
  81.         LOOP
  82.           ReadBytes (sf, ADR (buf), SIZE (buf), n);
  83.           IF n=0L THEN EXIT END;
  84.           WriteBytes (df, ADR (buf), n)
  85.         END;
  86.         Close (df);
  87.         IF State (df) < 0 THEN showErr ( State (df) ); RETURN TRUE END;
  88.         Close (sf);
  89.         Open (df, dname, readWrite);
  90.         SetDateTime (df, entry.date, entry.time);
  91.         Close (df);
  92.         SetFileAttr (dname, entry.attr, res);
  93.       END
  94.     END;
  95.     RETURN TRUE
  96.   END query;
  97.  
  98.  
  99. PROCEDURE usage;
  100.   BEGIN
  101.     WriteLn;
  102.     WriteString ('Aufruf: TCOPY quellDateien zielPfad [-U|-B]');
  103.     WriteLn;
  104.     WriteString ('        Kopiert mit Beibehaltung des Datums.');
  105.     WriteLn;
  106.     WriteString ('        -U kopiert nur die Dateien, die auf Zielpfad neueren Datums sind.');
  107.     WriteLn;
  108.     WriteString ("        -B wie '-U', zusätzlich Dateien, die auf Zielpfad nicht existieren.");
  109.     WriteLn;
  110.   END usage;
  111.  
  112.  
  113. VAR     result: INTEGER;
  114.         c: CHAR;
  115.  
  116. BEGIN
  117.   InitArgCV ( argc, argv );
  118.   IF argc > 2 THEN
  119.     Upper ( argv[3]^ );
  120.     IF Compare (argv[3]^, '-U') = equal THEN
  121.       update:= TRUE
  122.     ELSIF Compare (argv[3]^, '-B') = equal THEN
  123.       backup:= TRUE
  124.     END;
  125.     DirQuery ( argv[1]^, FileAttrSet {}, query, result );
  126.     IF result < 0 THEN showErr ( result ) END
  127.   ELSE
  128.     usage
  129.   END;
  130. END TCopy.
  131. ə
  132. (* $FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$000006AB$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66$FFF8CD66Ç$00000088T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000008F0$FFEE94CA$000008B3$00000125$000000F6$00000088$FFEE94D8$FFEE94D8$00000626$000006A8$000001F1$000006C0$0000069E$000006E3$0000069F$000008B4ÿÇÇ*)
  133.